(* Author: Diego Echeverri
Comments, bugs to diegoeche@gmail.com *)

#light
namespace LambdaMop
module Primitives =

    open System
    open System.Collections.Generic

    (*Helpers*)

    ///Usually compare
    let inline compareWith f x y = compare (f x) (f y)  

    ///Exception
    exception ConditionFailed of string
    let failwithCondition s =  raise <| ConditionFailed (s)

    ///Apply Functions to element 
    let invMap x l = Seq.map ( (|>) x) l    
    let inline sqr x = x * x 

    ///Euclidian Distance
    let inline distance (s1: #seq<'a>) (s2:#seq<'a>) =
        Seq.map2 (-) s1 s2 |> Seq.sumByFloat (float >> sqr) |> sqrt 

    let crossMap f l1 l2  =
        Seq.map (fun x -> Seq.map (f x) l2) l1 //Probably needs to be changed

    let crossIter f l1 l2  =
        Seq.iter (fun x -> Seq.iter (f x) l2) l1

    let crossIteri f l1 l2  =
        Seq.iteri (fun i x -> Seq.iteri (f i x) l2) l1


    (*The Real Code begins here*)

    ///This type is used  to represent a multiobjective problem.
    type MOP<'a, 'b> = {functions: seq<('a -> 'b)> ;
                        generator: unit -> 'a}

    let dominatedCompare (x:#seq<'a>) (y:#seq<'b>) =
        let rec auxCompare x_aux y_aux accum =
            match x_aux, y_aux, accum with
            | [],[],a -> a 
            | x::xs,y::ys, a when x = y -> auxCompare xs ys a                               
            | x::xs,y::ys, 0 -> auxCompare xs ys (compare x y)
            | x::xs,y::ys, a when a = compare x y -> auxCompare xs ys a
            | x::xs,y::ys, a when a <> compare x y -> 0
            | _,_,_ -> failwithCondition "Different Lengths"
        auxCompare (List.of_seq x) (List.of_seq y) 0   

    ///Useful Data Structure for Dominated-based optimization
    ///Warning! Allows multiple copies to be entered!
    type NonDominatedList<'a, 'b>(functions:seq<('a -> 'b)>) =
        let mutable list = []
        member this.Value:'a list = list
        member this.Add(solution:'a) = 
            let result = invMap solution functions
            let compareSol x = 
                functions |> invMap x |> dominatedCompare result
            let rec auxAdd remaining accumulated =
                match remaining with
                |[] -> (solution::accumulated,true)
                |x::xs when (compareSol x = 0) -> auxAdd xs (x::accumulated) 
                |x::xs when (compareSol x = -1) -> auxAdd xs accumulated 
                |x::xs when (compareSol x = 1) -> (accumulated @ x::xs,false)
                | _ -> failwith "Strange Comparator Behaviour" 
            let (l,b) = auxAdd list []
            list <- l ; b

    ///Applies the weights seq to all the functions 
    let weight (mop:MOP<'a,float>) (weights:#seq<float>)   =
        let weight f (w:float) = f >> ( ( * ) w)
        try
            {mop with functions = (Seq.map2 weight mop.functions weights)}
        with
            _ -> failwithCondition "|functions| = |weights|"

    ///Allows to convert a MOP optimization problem to a
    ///Mono-Objective optimization Problem
    let toMono (mop:MOP<'a,float>) (weights:#seq<float>) =
        let weighted = weight mop weights
        let f x = weighted.functions |> invMap x |> Seq.fold1 (+)
        {mop with functions = seq [f]}

    (*Mono objective algorithms*)
    
    ///Basic Random Search Algorithm
    let rec randomSearch (mop:MOP<'a,'b>) n current =
        let f = Seq.hd mop.functions //get first function
        match n with 
        | 0 -> (current,f current)
        | n when n > 0 -> 
            let next = mop.generator()
            (if (compareWith f current next) = 1 then current else next)
            |> randomSearch mop (n-1)
        | _ -> failwithCondition "n > -1"

    (*Multi-objective algorithms*)
    
    ///Basic Dominated Random Search Algorithm

    let dominatedRandomSearch (mop:MOP<'a,'b>) n =
        let nd_list = new NonDominatedList<'a,'b>(mop.functions)
        for i in {1..n} do
            nd_list.Add(mop.generator()) |> ignore
        nd_list.Value

